{-# LANGUAGE DeriveDataTypeable #-}
module ManagementStore where

import Types
import Management

import qualified Data.Map as Map (empty,insert,size,lookup,delete,fromList,toList,Map)
import Data.List (transpose)
import Data.Binary
import Data.Generics

import Maybe

import Debug.Trace

{-
map : management -> ID
map : ID -> management
map : ID -> (statistics)
map : score -> ID 


-}

type Statistics = (Cash,Cash,Cash,Int,Int)
-- min avg max tries insolvencies
type MgtID = Int
type Score = Cash

tries (_,_,_,x,_) = x

data ManagementStore 
    = MS { mgtoid :: (Map.Map Management MgtID ),
	   idtomg :: (Map.Map MgtID Management ),
           idtost :: (Map.Map MgtID Statistics ),
	   sctoid :: [(Score,MgtID)],
           size :: Int,
           maxsize:: Int,
           counter:: Int } -- to give us new ids on insertion!
    deriving (Show,Data,Typeable)

instance Binary ManagementStore where
  put (MS a b c d e f g) = put a >> put b >> put c >> put d >> put e >> put f >> put g
  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d  -> get >>= \e -> get >>= \f -> get >>= \g -> return (MS a b c d e f g)

empty :: Int -> ManagementStore
empty ma = MS Map.empty Map.empty Map.empty [] 0 ma 0

insert :: ManagementStore -> Management -> Score -> (MgtID,ManagementStore)
insert ms m s
    = let id = Map.lookup m (mgtoid ms)
      in if isJust id
	 then ((fromJust id),ms)
	 else is1 ms m s

-- NOTE - all insertion of new elements should go through this gate.
is1 ms m s
    = (id, ms { mgtoid = Map.insert m id (mgtoid ms) ,
                idtomg = Map.insert id m (idtomg ms),
                idtost = Map.insert id (newstat s) (idtost ms),
	        sctoid = addToAL (sctoid ms) s id ,
                ManagementStore.size = (ManagementStore.size ms) + 1,
                counter = (counter ms) + 1})
    where id = counter ms

newstat c = (c,c,c,1,ins c)
means (_,m,_,_,_) = m

summaryScore :: Statistics -> Score
summaryScore ss@(_,_,_,k,i)
    | k == 0 && i == 0 = means ss
    | k < 3 = means ss
    | k > 10 = platscore * (kfr - ifr) / kfr * (1/1.05) -- penalize if still around and going insolvent - a bit of a boost for novel ones too
    | otherwise = platscore
    where kfr = fromIntegral k
          ifr = fromIntegral i
          platscore = (kfr - ifr)/kfr * (means ss) * 1.3 -- tiny boost for longevity

updateStats :: Statistics -> Score -> Statistics
updateStats (min,mean,max,0,i) c
    = (c,c,c,1,ins c)
updateStats (min,mean,max,k,i) c
    = (if c < min
         then c
         else min,
       ((mean * (fromIntegral k)) + c) / (fromIntegral (k+1)),
       if c > max
         then c
         else max,
       k + 1,
       i + (ins c))

ins i 
    | i < 0 = 1
    | otherwise = 0

getMgtID :: ManagementStore -> Management -> Maybe MgtID
getMgtID ms m = ( Map.lookup m (mgtoid ms) )

update :: ManagementStore -> (Score,Management) -> ManagementStore
--update ms (s,m) | (trace ("Inserting, score: " ++ (show (s,(getMgtID ms m)))) False) = undefined
update ms (c,m)
    = let mid = Map.lookup m (mgtoid ms)
          id = fromJust mid
          nstat = updateStats (fromJust ( (flip Map.lookup) ( idtost ms) id)) c
          summaryscore = summaryScore nstat
	  newidtost = Map.insert id nstat (idtost ms)
	  newsctoid = addToAL [(c',m') | (c',m') <- (sctoid ms),m' /= (fromJust mid)] summaryscore (fromJust mid)
      in if isNothing mid
         then snd(ManagementStore.insert ms m c)
         else ms { idtost = newidtost, sctoid = newsctoid }

addList :: ManagementStore -> [(Score,Management)] -> ManagementStore
addList = foldl update 

getBest :: ManagementStore -> Int -> [Management]
--getBest ms _ 
--    | (trace ("\nBest management: " ++ (show (take 3 (sctoid ms)))) False) 
--    = undefined
getBest ms i
    = map (fromJust.(flip Map.lookup) (idtomg ms)) (map snd (take i (cycle $ sctoid ms)))


addToAL [] k v = [(k,v)]
addToAL al@([(k1,v1)]) k v
    | k >= k1 = (k,v):al
    | k < k1 = [(k1,v1),(k,v)] 
    | otherwise = [(k1,v1),(k,v)] -- I think for NaNs - certainly bugged here 
addToAL ar@((k1,v1):r@((k2,v2):l)) k v
    | k >= k1 = (k,v):ar 
    | k < k1 && k >= k2 = [(k1,v1),(k,v)] ++ r
    | otherwise = (k1,v1):(addToAL r k v)

resetScores :: ManagementStore -> ManagementStore 
resetScores ms =
    ms { sctoid = [ (0,id) | (_,id) <- (sctoid ms) ],
         idtost = Map.fromList [ (id,newstat 0) | (id,_) <- Map.toList (idtost ms) ] }

cleanup :: ManagementStore -> ManagementStore
-- cleanup ms 
--    | (trace ("\nStats: " ++ (show (ManagementStore.size ms)) ++ " " ++ (show $ maxsize ms) ++ " " ++(show$counter ms))  False) = undefined
cleanup ms
        | ManagementStore.size ms <= maxsize ms = ms
        | otherwise
          = let thinkdelete = (drop (maxsize ms) (sctoid ms))
                todelete = [ id | (sc,id) <- thinkdelete, sc < 0 ] -- just nuke those who never got solvent ...
            in foldl deleteID ms todelete

deleteID :: ManagementStore -> MgtID -> ManagementStore
deleteID ms id =
    ms { idtomg = Map.delete id (idtomg ms),
         idtost = Map.delete id (idtost ms),
         mgtoid = Map.delete mg (mgtoid ms),
         sctoid = [ s | s <- (sctoid ms), (snd s) /= id ],
         ManagementStore.size = (ManagementStore.size ms - 1)}
    where mg = fromJust$ Map.lookup id (idtomg ms)

--outCrossManagement = id
outCrossManagement :: [ManagementStore] -> [ManagementStore]
outCrossManagement mgts 
    = let nmlists = transposieGoodness (map sctom mgts)
      in map (uncurry addList) (zip (map (empty.maxsize) mgts) nmlists)

transposieGoodness :: [[a]] -> [[a]]
transposieGoodness x = grabChunks (length $ head x) $ concat $ transpose x
    where grabChunks _ [] = []
          grabChunks n x = (take n x):(grabChunks n (drop n x)) -- XXX add splitty goodness



sctom :: ManagementStore -> [(Score,Management)]
sctom mgtst = [ (sc, fromJust $ Map.lookup id (idtomg mgtst)) | (sc,id) <- sctoid mgtst ]

lookupStatistics :: ManagementStore -> Management -> Maybe Statistics
lookupStatistics ms m =
    Map.lookup m (mgtoid ms) >>= \id -> Map.lookup id (idtost ms)